perm filename ITMSBX.OLD[MSS,LCS] blob
sn#107250 filedate 1974-06-15 generic text, type T, neo UTF8
C**** ITMSUB, RNOTE ********
C ********** WHOLE & HALF RESTS, BEAMS ******
SUBROUTINE ITMSUB
IMPLICIT INTEGER(A-Q,S-Z)
REAL DIS,PWDS,DISX,HGT,POS,CENTR,STFF,HGT1
COMMON/STF/RSTFAC(8),RSTJC/MIN/MINI,RMINI
COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/BM/RA,RC,RJY
COMMON/POSI/STFF(8),JJB,POS/PLTR/PLT,RHT,DIS
EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(JE,JQ(3)),(RJE,RJQ(3))
1,(RJF,RJQ(4)),(JG,JQ(5)),(JH,JQ(6)),(JI,JQ(7)),(JJ,JQ(8))
1,(JK,JQ(9)),(JF,JQ(4)),(RJI,RJQ(7)),(RJH,RJQ(6))
1 ,(RJG,RJQ(5)),(RJD,RJQ(2)),(RJI,RJQ(7)),(RJJ,RJQ(8))
DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/
RST7=RSTJC*7.
RST18=RSTJC*18.
C TO COMPENSATE FOR NOTE #3 COMING AT POS=0
RJBQ=JB
JY=0
IF(JA.EQ.9)GO TO 90
IF(JA.EQ.10)GO TO 100
C GO TO LINES, BEAMS, STAVES.
C NEXT DRAWS STRAIGHT LINES
RD=RJD*RST7
RA=0
C WHY "*RSTJC"????
RX=RTF+POS
IF(JE.EQ.50)GO TO 300
IF(RJF.GT.0)GO TO 401
C FOR BAR LINES
JA=44
C CODE # IS CHNGD SO BAR LINES WON'T AFFECT MAX. HGT.
IF(JG)GO TO 407
IF(JG.EQ.0)JG=JD/100
RA=1
IF(PLT.GE.0)GO TO 40
JG=JG+1
RA=1./DIS
C BAR LINES PLOT AS DOUBLE THICKNESS
40 RX=RTF*RSTJC+POS
L=MOD(JD,100)+JC+3
C JD=401 MAKES 4X THICK BARLINE - ONE STAFF
RY=STFF(L)+.5+RSTFAC(L)*58.
RW=RY
RJX=RJBQ
42 CALL LINES(RJBQ,RX,3)
IF(JG.EQ.-2)GO TO 404
C IF JG<0 THEN WIGGLEY LINES ARE MADE.
RJ=-1.
406 CALL LINES(RJX,RY,2)
IF(JG.LE.0)RETURN
C FOR 'HEAVY' LINE.
RJX=RJX+RA
CALL LINES(RJX,RY,2)
JG=JG-1
RY=RW
IF(RJ)RY=RX
RJ=-RJ
GO TO 406
43 IF(RA.GT.0)GO TO 403
RETURN
C HOV IS RA.NE.0?
C DRAWS BAR LINES. JD>0 CAUSES FULL LINE.
403 RA=RA-3.72
RJBQ=RJBQ+22
RJX=RJX+22
C DO ABOVE NEED *RSTJC? ************
C **** BASED ON '596' ****
GO TO 42
C FOR CRESC., DECRESC.
300 RA=ABS(RJG/2.0)*RST7
C AMOUNT OF SPREAD
RJ=RJBQ
RX=RX-RST18+RD
IF(RJH.NE.0)GO TO 302
C JUMP TO MAKE BOX
RJF=RHORZ(RJF)
IF(RJG)GO TO 301
RJ=RJF
RJF=RJBQ
301 CALL LINX(RJ,RX+RA,RJF,RX)
CALL LINES(RJ,RX-RA,2)
C FOR CRESC, DECRESC: 4 POS1, STF, HGT, 50, POS1, +OR-N
RETURN
302 RJH=RJH*RST7
RJI=RJI*RST7
IF(RJI.EQ.0)RJI=RJH
RJB=RJBQ-RJH/2.
RX=RX-RJI/2.
C DRAWS BOX, CENTER IS IN MIDDLE
C 4,POS,STF,NT#,50,0,0,,SIZ1[BY NT#S],SIZ2
CALL LINX(RJB,RX,RJB+RJH,RX)
CALL LINES(RJB+RJH,RX+RJI,2)
CALL LINES(RJB,RX+RJI,2)
CALL LINES(RJB,RX,2)
RETURN
C DASHES
401 POS=POS-RST18
C********* 27/9/72 ******
IF(JG.EQ.0)GO TO 407
IF(ABS(RJF-RJB).LT..01)GO TO 402
C VERTICAL DASHES IF P6=P2
RA=RJF-RJB-4.
RJF=RJB+2
IF(JG.GT.0)JG=0
GO TO 407
402 RA=POS+RJE*RST7
IF(RJH.EQ.0)RJH=.8
C P8 CAN SET SIZE OF DASH
RJ=RJH*RST7
RX=RD+POS
L=3
K=2
41 IF(RX.GT.RA)RETURN
C DASHES MUST GO FROM BOTTOM TO TOP.
CALL LINES(RJBQ,RX,L)
RX=RX+RJ
CALL EXCH(K,L)
GO TO 41
407 RX=RD+POS
RY=RJE*RST7+POS
IF(JG.EQ.-1)GO TO 408
C FOR 'TR' JG=-2, 'ARPEGG' JG=-1
RJX=IFIX(RHORZ(RJF))
GO TO 42
C DRAWS STRAIGHT LINES. ETC.
404 L=(RA+4)/1.5
RJ=RY
DO 405 K=1,L
CALL LINES(RJX,RJ,2)
RJX=RJX+9
C *RSTJC?
405 CALL EXCH(RX,RJ)
RETURN
408 IF(RX.GT.RY)CALL EXCH(RX,RY)
RA=4.
IF(RJH.NE.0)RA=RJH*4.
C USE P8 TO SET WIGGLE WIDTH. (HGT CANNOT BE CHANGED YET..)
RX=RX-12.*RSTJC
RJ=6.*RSTJC
RJX=4*RSTJC
RW=RJBQ-RJX
CALL LINES(RW,RX-RJ,3)
RJX=RA*RSTJC
410 CALL LINES(RJBQ+RJX,RX,2)
CALL LINES(RW,RX+RJ,2)
RX=RX+12.*RSTJC
IF(RX.LT.RY)GO TO 410
RETURN
C VERTICAL WIGGLE
C NEXT IS FOR BEAMS
90 RMINI=RSTJC
RX=2.7*RSTJC
C******************************
IF(JJ.LT.10)GO TO 91
C NEXT FOR INNER, PARTIAL BEAMS
RJJ=AMOD(RJJ,10.)
GO TO(2,3,4),JJ/10
2 RJH=RJI+RX
GO TO 4
3 RJH=RJI-RX
C 10=SHORT PARTIAL LFT→RT., 20=RT.←LFT, 30=TO POS IN P8
4 RH=RHORZ(RJH)
C LEFT INNER POS.
GO TO 1
C******************************
91 IF(JH.GE.0)GO TO 1
92 RJI=RJB+RX
IF(JH.LE.-20)RJI=RJF-RX
192 JH=-JH
IF(JJ.EQ.0)JJ=MOD(JH,10)
JH=JH-JJ
IF(JJ.EQ.0)JJ=1
RJJ=JJ
C IF P8 NEG, P9 IS AUTOMATIC, ALSO P10 IF NEEDED.
1 IF(IABS(JD).LT.100)GO TO 97
RMINI=.6*RSTJC
RJE=AMOD(RJE,100.0)
C SPACE BETWEEN BEAMS
97 RJ=RMINI*11.
RW=RMINI*RHGT
C DIST. UP OR DOWN FROM NOTE HEAD.
RJA=RJJ*RJ
C DISPLACEMENT
RD=RHORZ(ABS(RJI))
C POSITION 3
RJX=CENTR-RW+RJA
C FINAL HEIGHT
CC?????? RX=MOD(JG,10)-MOD(JH,10)
RX=MOD(JG,10)
JJB=JG-20
RA=RHORZ(RJF)
C HORIZANTAL DIST.
RJY=RJE*RST7+POS-RST18-RW+RJA
C************************
RW=R14*RMINI
IF(JG.GE.20)GO TO 93
C JUMP IF STEMS ARE DOWN
JJB=JG-10
RJ=-RJ
CCAUG.7,73 RJA=RMINI*R2HGT-2.*RJA-3.
RY=-3
IF(RMINI.LT..65)RY=-1
RJA=RMINI*R2HGT-2.*RJA+RY
RJX=RJX+RJA
RJY=RJY+RJA
RJBQ=RJBQ+RW
C POSITION 1
RA=RA+RW
C POSITION 2
RD=RD+RW
C******************************
RH=RH+RW
93 IF(JJB.GT.RX)GO TO 94
IF(JJ.GE.10)GO TO 7
C**********************
IF(JH.EQ.0)GO TO 94
RJC=RW
C******************************
IF(RJI.EQ.0)GO TO 292
IF(JH.GE.20)GO TO 193
C******************************
CC IF(JI.GT.0)GO TO 293
293 RX=RJBQ-RD
GO TO 194
C******************************
7 RHX=RH-RJBQ
CC RJC=RX-RJBQ
RJC=RD-RJBQ
GO TO 292
193 RX=RD-RA
194 RJC=ABS(RX)
292 DISX=ABS(RJBQ-RA)
HGT=RJX-RJY
IF(JJ.GE.10)HGT1=HGT*RHX/DISX
C**********************
RJC=RJC/DISX
195 HGT=HGT*RJC
196 L=JH/10
JH=0
IF(JJ.GE.10)GO TO 8
C***************
IF(L.EQ.1)GO TO 95
C BEAM LFT=1, RT=2 (PARAM 8=10 OR 20)
RJBQ=RD
RJX=RJY+HGT
GO TO 94
C**************
8 RJBQ=RH
RA=RD
RJY=RJX-HGT
RJX=RJX-HGT1
GO TO 94
95 RA=RD
RJY=RJX-HGT
94 RC=0
L=6
IF(RMINI.LT..65)L=3
CALL LINES(RJBQ,RJX,3)
DO 941 K=1,L
CALL BMS
IF(PLT.GE.0)GO TO 940
RC=RC+1
CALL BMS
CALL EXCH(RA,RJBQ)
941 CALL EXCH(RJY,RJX)
CALL BMS
C DRAWS 5 LINES FOR BEAMS.
940 JJB=JJB-1
IF(JJB.LE.0)RETURN
C IF P7=10 OR 20 ONE BEAM WILL APPEAR.
RJY=RJY+RJ
RJX=RJX+RJ
GO TO 93
100 RA=0
RJB=RHORZ(RJB)
RJ=RHORZ(FLOAT(JD))
IF(JD.EQ.0)RJ=596
C FOR STAFF LINES: 10, POS 1, HGT(3 TO -3), 2ND POS., UP-DOWN(NT #S)
JC=JC+4
IF(RJF.EQ.0)RJF=RSTFAC(JC)
IF(RJF.EQ.0)RJF=1.
RSTFAC(JC)=RJF
STFF(JC)=(JC-1)*123-369.+RJE*7.*RJF
RX=STFF(JC)+RTF*RJF
C FOR RTF SEE DATA
C FOR 2 PASS PLOTTING
RJF=RJF*14.
DO 6 K=1,5
RZ=RJ
RW=RJB
IF(K.EQ.2.OR.K.EQ.4)CALL EXCH(RW,RZ)
CALL LINX(RZ,RX,RW,RX)
6 RX=RX+RJF
END
SUBROUTINE BMS
COMMON/STF/RSTFAC(8),RSTJC/BM/RA,RC,RJY
CALL LINES(RA,RJY+RC*RSTJC,2)
END
SUBROUTINE METER
COMMON /STF/RSTFAC(8),RSTJC
COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(JE,JQ(3)),(RJD,RJQ(2))
1,(RJF,RJQ(4)),(JF,JQ(4)),(RJE,RJQ(3)),(RJG,RJQ(5))
1,(RJH,RJQ(6)),(RJG,RJQ(5))
C PARAMS 18 / POS / STF / TOP NUM/ BOT NUM/ VERT.HGT/ SIZE FAC.
KC=10.*RSTJC+JB
JX=JB
JA=5
RJE=RJG
IF(RJE.EQ.0)RJE=1.
IF(JD.GT.9)GO TO 10
IF(JE.GT.9)GO TO 20
M=2
JF=JD
19 RJD=(8.+RJF)*RJE
C MULTS BY SIZE FACTOR
9 CALL NOTWRT
GO TO (1,2,3,4,5),M
1 RETURN
C ****** 4/(4) *****
2 JF=JE
M=1
11 RJD=(4.+RJF)*RJE
GO TO 9
C ******* (1)2/16 *******
10 JF=JD/10
M=3
GO TO 19
C ****** 1(2)/16 *******
3 M=4
39 JB=JB+20.*RSTJC
JF=MOD(JD,10)
GO TO 9
4 IF(JE.LT.9)GO TO 30
C ******** 12/(1)6 ******
JB=JX
JF=JE/10
M=5
GO TO 11
C ******* 12/1(6) ********
5 JD=JE
M=1
GO TO 39
C ********* 12/(8) ********
30 JB=KC
GO TO 2
C ******** 4/16 *******
20 M=4
JB=KC
JF=JD
GO TO 19
END
SUBROUTINE RNOTE(X)
COMMON /PTR/PWDS(250),ITEM,L,I,IX/XRN/RN(4000)
X=RN(IFIX(PWDS(IFIX(AMOD(X,1000.))))+2)
END